home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / fouran.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  4.3 KB  |  123 lines
  1.       subroutine fouran
  2.       implicit double precision (a-h,o-z)
  3. c
  4. c     this routine determines the fourier coefficients of a transient
  5. c analysis waveform.
  6. c
  7. c spice version 2g.6  sccsid=tabinf 3/15/83
  8.       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
  9.      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
  10.      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
  11.      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
  12.      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
  13.      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval,
  14.      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
  15.      7   irowno,jcolno,nttbr,nttar,lvntmp
  16. c spice version 2g.6  sccsid=cirdat 3/15/83
  17.       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
  18.      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc
  19. c spice version 2g.6  sccsid=flags 3/15/83
  20.       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
  21.      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof
  22. c spice version 2g.6  sccsid=miscel 3/15/83
  23.       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
  24.      1  defas,rstats(50),iwidth,lwidth,nopage
  25. c spice version 2g.6  sccsid=status 3/15/83
  26.       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
  27.      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon,
  28.      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile
  29. c spice version 2g.6  sccsid=knstnt 3/15/83
  30.       common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok,
  31.      1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox,
  32.      2   pivtol,pivrel
  33. c spice version 2g.6  sccsid=tran 3/15/83
  34.       common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg
  35. c spice version 2g.6  sccsid=outinf 3/15/83
  36.       common /outinf/ xincr,string(15),xstart,yvar(8),itab(8),itype(8),
  37.      1   ilogy(8),npoint,numout,kntr,numdgt
  38. c spice version 2g.6  sccsid=blank 3/15/83
  39.       common /blank/ value(200000)
  40.       integer nodplc(64)
  41.       complex cvalue(32)
  42.       equivalence (value(1),nodplc(1),cvalue(1))
  43. c
  44. c
  45.       dimension sinco(9),cosco(9)
  46.       dimension fortit(4)
  47.       data fortit / 8hfourier , 8hanalysis, 8h        , 8h         /
  48.       data ablnk / 1h  /
  49. c
  50. c
  51.       forprd=1.0d0/forfre
  52.       xstart=tstop-forprd
  53.       kntr=1
  54. cc    xn=101.0d0
  55.       xincr=forprd/npoint
  56. cc    npoint=xn
  57.       call getm8(locx,npoint)
  58.       call getm8(locy,npoint)
  59.       do 105 nknt=1,nfour
  60.       itab(1)=nodplc(ifour+nknt)
  61.       kfrout=itab(1)
  62.       call ntrpl8(locx,locy,numpnt)
  63.       dcco=0.0d0
  64.       call zero8(sinco,9)
  65.       call zero8(cosco,9)
  66.       loct=locy+1
  67.       ipnt=0
  68.    10 yvr=value(loct+ipnt)
  69.       dcco=dcco+yvr
  70.       forfac=dble(ipnt)*twopi/npoint
  71.       arg=0.0d0
  72.       do 20 k=1,9
  73.       arg=arg+forfac
  74.       sinco(k)=sinco(k)+yvr*dsin(arg)
  75.       cosco(k)=cosco(k)+yvr*dcos(arg)
  76.    20 continue
  77.       ipnt=ipnt+1
  78.       if (ipnt.ne.npoint) go to 10
  79.       dcco=dcco/npoint
  80.       forfac=2.0d0/npoint
  81.       do 30 k=1,9
  82.       sinco(k)=sinco(k)*forfac
  83.       cosco(k)=cosco(k)*forfac
  84.    30 continue
  85.       call title(0,72,1,fortit)
  86.       ipos=1
  87.       call outnam(kfrout,1,string,ipos)
  88.       call move(string,ipos,ablnk,1,7)
  89.       jstop=(ipos+6)/8
  90.       write (iofile,61) (string(j),j=1,jstop)
  91.    61 format(' fourier components of transient response ',5a8///)
  92.       write (iofile,71) dcco
  93.    71 format('0dc component =',1pd12.3/,
  94.      1   '0harmonic   frequency    fourier    normalized    phase     no
  95.      2rmalized'/,
  96.      3   '    no         (hz)     component    component    (deg)    pha
  97.      4se (deg)'//)
  98.       iknt=1
  99.       freq1=forfre
  100.       xnharm=1.0d0
  101.       call magphs(cmplx(sngl(sinco(1)),sngl(cosco(1))),xnorm,pnorm)
  102.       phasen=0.0d0
  103.       write (iofile,81) iknt,freq1,xnorm,xnharm,pnorm,phasen
  104.    81 format(i6,1pd15.3,d12.3,0pf13.6,f10.3,f12.3/)
  105.       thd=0.0d0
  106.       do 90 iknt=2,9
  107.       freq1=dble(iknt)*forfre
  108.       call magphs(cmplx(sngl(sinco(iknt)),sngl(cosco(iknt))),
  109.      1   harm,phase)
  110.       xnharm=harm/xnorm
  111.       phasen=phase-pnorm
  112.       thd=thd+xnharm*xnharm
  113.       write (iofile,81) iknt,freq1,harm,xnharm,phase,phasen
  114.    90 continue
  115.       thd=100.0d0*dsqrt(thd)
  116.       write (iofile,101) thd
  117.   101 format (//5x,'total harmonic distortion =  ',f12.6,'  percent')
  118.   105 continue
  119.       call clrmem(locx)
  120.       call clrmem(locy)
  121.   110 return
  122.       end
  123.